Underwater rates

We have two data negative equity via the real estate analytics firm CoreLogic: Negative equity share of all homes by county by month-year from 2009 to present and negative equity share of all homes by ZIP code in 2019. Note: We are waiting for a third data set, which they sent to us, but had errors I identified (only had data for four states), of negative equity share of all homes by ZIP code by month-year from 2009-present.

Demographic and Economic Data

We pulled select racial, ethnic origin and economic variables from the U.S. Census American Community Survey, via the Tidycensus package.

Load and clean Zillow data

From the real estate data firm Zillow, we pulled information on current, historical and forecast community home values. Zillow has also done extensive work on underwater homes, but stopped releasing data in 2017.

Load and clean urban-rural county designation and unemployment data

The USDA classifies county on a scale from 1 (most urban) to 9 (most rural). Unemployment via BLS in 2018.

# County rural urban code designation from USDA
# Spectrum from 1 (most urban) to 9 (most rural)
rural_urban <- read_xls("../data/input_data/rural_urban_codes/ruralurbancodes2013.xls") %>%
  rename(fips_code = FIPS)

# Unemployment by county from BLS 2018
unemployment <- read_xlsx("../data/input_data/bls/laucnty18.xlsx") %>%
  mutate(fips_code = paste0(state_fips,county_fips)) %>%
  dplyr::select(fips_code, county_state, unemployment_rate_2018 = unemployment_rate)

Join data frames

Put together CoreLogic county/ZIP code level underwater data with U.S. census data, USDA ruralness data, Zillow data.

## Make county data frames (2009-2019 time series)

# Underwater data, census data, rural data - 2446 counties
underwater_county_year_no_zillow <- underwater_county_year %>%
  ungroup() %>%
  inner_join(rural_urban) %>%
  dplyr::select(-State,-Population_2010, -County_Name, -Description) %>%
  inner_join(acs_data_county, by=c("fips_code" = "geoid")) %>%
  dplyr::select(fips_code, state_name = state_name.x, county_name, starts_with("RUCC"), starts_with("pct"), starts_with("median")) %>%
  inner_join(unemployment) %>%
  dplyr::select(-county_state)

## Joining, by = "fips_code"
## Joining, by = "fips_code"

# Underwater data, census data, rural data, Zillow data - 1477 counties 
underwater_county_year_yes_zillow <- underwater_county_year_no_zillow %>%
  inner_join(county_summary_forecast) %>%
  dplyr::select(-RegionName, -State) 

## Joining, by = "fips_code"

## Make ZIP Code dataframes (2019 only)

# Underwater data, census data - 28989 zip codes
underwater_zips_2019_no_zillow <- underwater_zips_2019 %>%
  ungroup() %>%
  inner_join(acs_data_zcta, by=c("zip_code" = "geoid")) %>%
  dplyr::select(zip_code, everything(),-name) 

# Underwater data, census data, Zillow data - 13729 zip codes

underwater_zips_2019_yes_zillow <- underwater_zips_2019_no_zillow %>%
  inner_join(zip_summary_forecast) %>%
  dplyr::select(-State) 

## Joining, by = "zip_code"

rm(list=setdiff(ls(), c("underwater_zips_2019_no_zillow", "underwater_zips_2019_yes_zillow", "underwater_county_year_no_zillow", "underwater_county_year_yes_zillow", "flattenCorrMatrix", "negative_equity_summary_county", "negative_equity_summary_zip")))

Load Shapefiles

#ZCTAs can take several minutes to download.  To cache the data and avoid re-downloading in future R sessions, set `options(tigris_use_cache = TRUE)`
options(tigris_use_cache = TRUE)

# ZIP Code Points
data(zipcode)

# ZCTA shapefiles
zctas <- zctas(cb=TRUE)

# Counties
counties <- counties(cb = TRUE)

Negative Equity Clusters in 2019

Though negative equity rates are nowhere near 2009 levels, the analysis identified 10 clusters with a higher negative equity rates relative to the rest of the country.

In the map below, click on the two-letter buttons at right to zoom to that cluster.

Click on each ZIP code to see info about each county.

Clusters * MD1 | Maryland+DC | Cluster of ZIP Codes in Prince George’s County and Anacostia in D.C. and down through Waldorm, in Charles County. * MD2 | Maryland Eastern Shore | Huge chunks of the lower Eastern Shore, through Salisbury and Ocean City. * NJ1 | South New Jersey | Large swaths of southern New Jersey, including Atlantic City, Philly suburbs. * NJ2 | North Jersey+NYC | New York City suburbs, including Newark, Elizabeth, Paterson, parts of Queens * CT | Connecticut | Several areas, including Hartford and Waterbury, Bridgeport and New Haven, up to Rhode Island border. * IA | Iowa | a bunch of communities in Iowa with no real clusters. Can’t make heads or tails of this. * FL | Florida | Worst issues in Miami, Hialeah and Homestead, scatterd parts of the state. * IL | Chicago | Huge issues surrounding Chicago, especially on South Side * CA | California | Issues in Fresno, south of Monterey, scattered throughout. * NV | Las Vegas | * No buttons, but interesting | Baton Rouge, New Orleans, Atlanta, North Dakota

# Filter for only high negative equity zip codes
high_negative_equity_zips <- underwater_zips_2019_no_zillow %>%
  filter(percent_negative_equity >= 5)

# Join zip code coordinates to negative equity by zipcode
high_negative_equity_zips_geo <- geo_join(zctas, high_negative_equity_zips, 'GEOID10', 'zip_code', 
how = "inner")

# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_zips_geo$percent_negative_equity, 5, pretty = FALSE)

# Draw map
leaflet(high_negative_equity_zips_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(percent_negative_equity), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_zips_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = colorBin("plasma", high_negative_equity_zips_geo$percent_negative_equity), 
             values = high_negative_equity_zips_geo$percent_negative_equity,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

datatable(high_negative_equity_zips, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: ZIP codes with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

This map shows county-level averages. There were 89 counties with a negative equity rate above 4 percent in 2019.

# Filter for 2019
high_negative_equity_county_2019 <- underwater_county_year_no_zillow %>%
  #dplyr::select(state_code, fips_code, state_name, county_name, y2019) %>%
  filter(pct_negative_equity_y2019 >= 4) %>%
  arrange(desc(pct_negative_equity_y2019))

# Join zip code coordinates to negative equity by zipcode
high_negative_equity_county_2019_geo <- geo_join(counties, high_negative_equity_county_2019, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_county_2019$pct_negative_equity_y2019, 5, pretty = FALSE)

# Draw map
leaflet(high_negative_equity_county_2019_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2019), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2019_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addHomeButton(extent(-98.39355468750001, -89.60449218750001, 39.85072092501597, 43.8899753738369), "IA") %>%
   addHomeButton(extent(-115.44021606445314, -114.89089965820314, 36.04521273039952, 36.318998009207924), "NV") %>%
   addHomeButton(extent(-127.24365234375001, -109.66552734375001, 31.98944183792288, 40.713955826286046), "CA") %>%
   addHomeButton(extent(-88.33145141601564, -87.23281860351564, 41.466399253078876, 41.97276436226528), "IL") %>%
   addHomeButton(extent(-80.82092285156251, -79.72229003906251, 25.517657429994035, 26.12831612064242), "FL") %>%
   addHomeButton(extent(-73.95446777343751, -71.75720214843751, 41.03793062246529, 42.05337156043361), "CT") %>%
   addHomeButton(extent(-74.46807861328126, -73.91876220703126, 40.57484790030712, 40.83199550584334), "NJ2") %>%
   addHomeButton(extent(-75.86883544921876, -73.67156982421876, 39.16414104768742, 40.20824570152502), "NJ1") %>%
   addHomeButton(extent(-76.95098876953126, -74.75372314453126, 38.10214399750345, 39.16201148082406), "MD2") %>%
   addHomeButton(extent(-77.1947479248047, -76.6454315185547, 38.791021386961596, 39.0549177529185), "MD1") %>%
   addHomeButton(extent(-131.74804687500003, -61.43554687500001, 18.812717856407776, 52.908902047770255 ), "U.S.") %>%
   
   addLegend("bottomleft", 
             pal = binpal, 
             values = high_negative_equity_county_2019_geo$pct_negative_equity_y2019,
    title = "% Homes Negative Equity 2019",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

datatable(high_negative_equity_county_2019, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: Counties with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

By comparison, this is every county in the U.S. in 2009 with a negative equity rate above 4 percent, 654 counties. That’s about 25 percent of counties. The problem was much more widespread following the financial crisis.

# Filter for 2009
high_negative_equity_county_2009 <- underwater_county_year_no_zillow %>%
  #dplyr::select(state_code, fips_code, state_name, county_name, y2009) %>%
  filter(pct_negative_equity_y2009 >= 4) %>%
  arrange(desc(pct_negative_equity_y2009))

# Join zip code coordinates to negative equity by zipcode
high_negative_equity_county_2009_geo <- geo_join(counties, high_negative_equity_county_2009, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", high_negative_equity_county_2009_geo$pct_negative_equity_y2009, 5, pretty = FALSE)

# Draw map
leaflet(high_negative_equity_county_2009_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2009), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2009_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addLegend("bottomleft", 
             pal = binpal, 
             values = high_negative_equity_county_2009_geo$pct_negative_equity_y2009,
    title = "% Homes Negative Equity 2009",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

datatable(high_negative_equity_county_2009, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2009: Counties with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

This map shows 2009 negative equity rates in counties to shows only the top 89 counties in 2009 (the same number of counties with > 4 percent negative equity in 2019). It allows us to see which places were the most problematic in 2009.

# Filter for 2009
top_negative_equity_county_2009 <- underwater_county_year_no_zillow %>%
  #dplyr::select(state_code, fips_code, state_name, county_name, y2009) %>%
  arrange(desc(pct_negative_equity_y2009)) %>%
  head(n=89)

# Join zip code coordinates to negative equity by zipcode
top_negative_equity_county_2009_geo <- geo_join(counties, top_negative_equity_county_2009, 'GEOID', 'fips_code', 
how = "inner")  

# Color Scheme
binpal <- colorBin("plasma", top_negative_equity_county_2009_geo$pct_negative_equity_y2009, 5, pretty = FALSE)

# Draw map
leaflet(top_negative_equity_county_2009_geo) %>%
   addProviderTiles(providers$CartoDB.Positron) %>%
   #addProviderTiles(providers$Wikimedia) %>%
   addPolygons(fillColor = ~binpal(pct_negative_equity_y2009), weight = 1, smoothFactor = 0.5, opacity = 0.1, fillOpacity = 0.5, color="black", popup = popupTable(high_negative_equity_county_2009_geo)) %>%
   setView(-95, 39.335359608681216, 4) %>%
   addLegend("bottomleft", 
             pal = binpal, 
             values =top_negative_equity_county_2009_geo$pct_negative_equity_y2009,
    title = "% Homes Negative Equity 2009",
    labFormat = labelFormat(prefix = ""),
    opacity = 1
  ) %>%
  addEasyButton(easyButton(
    states = list(
      easyButtonState(
        stateName="unfrozen-markers",
        icon="ion-toggle",
        title="Get Bounding box",
        onClick = JS("
                     function(btn, map) {
                        alert(
                         map.getBounds().getWest() + ', ' + map.getBounds().getEast() + ', ' + map.getBounds().getSouth() + ', ' + map.getBounds().getNorth() 
                        );
                        
                     }")
      )
    )
  )
)

datatable(top_negative_equity_county_2009, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2009: 89 Counties with highest negative equity rates'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

There’s not a lot of crossover. Only 13 counties on the list of the highest negative equity counties in 2009 were also there in 2019, including two Maryland counties.

on_both <- top_negative_equity_county_2009 %>%
  inner_join(high_negative_equity_county_2019, by=c("fips_code", "county_name", "state_name", "pct_negative_equity_y2009", "pct_negative_equity_y2019")) %>%
  dplyr::select(fips_code, county_name, state_name, pct_negative_equity_y2009, pct_negative_equity_y2019)


datatable(on_both, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    'County with highest rates in 2019 and 2009'
  ),
  options = list(scrollX=TRUE,scrollY=TRUE, scrollCollapse=TRUE, pageLength = 13)
)

Historical Comparisons

In the average and median U.S. county, underwater rates nowhere near as high as they used to be in the years immediately following the crash of the housing market. In 2009, the average U.S. county had 5.5 percent of homes with negative equity, compared to 1.52 percent today. The median showed a less dramatic decline. The 2009 mean is skewed up by some extremely high rates in select counties in 2009.

x <- underwater_county_year_no_zillow %>%
  pivot_longer(cols=c("pct_negative_equity_y2009", "pct_negative_equity_y2010", "pct_negative_equity_y2011", "pct_negative_equity_y2012","pct_negative_equity_y2013","pct_negative_equity_y2014","pct_negative_equity_y2015","pct_negative_equity_y2016","pct_negative_equity_y2017","pct_negative_equity_y2018","pct_negative_equity_y2019"), names_to = "year", values_to = "percent_negative_equity") %>%
  group_by(year) %>%
  filter(!is.na(percent_negative_equity)) %>%
  summarise(mean_percent_negative_equity = round(mean(percent_negative_equity),2),
    median_percent_negative_equity = round(median(percent_negative_equity),2)
            )

datatable(x, class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    'Mean and median negative equity county rates by year 2009 and 2019'
  ),
  options = list(scrollX=TRUE,scrollY=TRUE, scrollCollapse=TRUE, pageLength = 11)
)

Explaining the differences

In general, amongst the highest negative equity zips, there’s a general trend. The higher the rate of af american and hispanics, the higher the rate.

# Average table
underwater_zips_2019_no_zillow %>%
  mutate(negative_equity_group = case_when(percent_negative_equity > 4 ~ "greater than 4",
                                      TRUE ~ "less than 4")
         ) %>%
  filter(!is.na(pct_black_2017), !is.na(median_household_income_2017)) %>%
  group_by(negative_equity_group) %>%
  summarise(pct_black_2017 = round(mean(pct_black_2017),2),
            pct_white_2017 = round(mean(pct_white_2017),2),
            pct_hispanic_2017 = round(mean(pct_hispanic_2017),2),
            median_household_income_2017 = round(mean(median_household_income_2017),2)) %>%
  datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    'Averages'
  ),
  options = list(scrollX=TRUE,scrollY=TRUE, scrollCollapse=TRUE, pageLength = 11)
)

We also see a fairly stark difference in the negative equity rate in majority minority ZIP codes, compared with majority white ZIP codes.

# Average table
underwater_zips_2019_no_zillow %>%
  mutate(population_makeup= case_when(pct_white_2017 > 50 ~ "majority white",
                                      TRUE ~ "majority minority")
         ) %>%
  filter(!is.na(percent_negative_equity)) %>%
  group_by(population_makeup) %>%
  summarise(percent_negative_equity = round(mean(percent_negative_equity),2)) 

And amongst higher negative equity ZIP codes (>= 4%), we see significant trends towards higher rates of negative equity as ZIP codes’ in more African-American and Hispanic areas.

# Correlation for higher rate counties
underwater_zips_2019_no_zillow_trimmed <- underwater_zips_2019_no_zillow %>%
  dplyr::select(-zip_code,-state_name,-county_name) %>%
  filter(percent_negative_equity >=4)  

# Create correlation matrix
underwater_zips_2019_no_zillow_correlation_matrix <- rcorr(as.matrix(underwater_zips_2019_no_zillow_trimmed))

# Flatten correlation table, to only include significant predictors p < .05
underwater_zips_2019_no_zillow_correlation_matrix <- flattenCorrMatrix(underwater_zips_2019_no_zillow_correlation_matrix$r, underwater_zips_2019_no_zillow_correlation_matrix$P) %>%
  mutate(absolute_cor = abs(cor)) %>%
  filter(row == "percent_negative_equity") %>%
  filter(p < .05) %>%
  arrange(desc(absolute_cor)) %>%
  dplyr::select(-absolute_cor)

# Print correlation matrix.  Let's us see both r (correlation coefficient) and p value for each predictor on an individual level
underwater_zips_2019_no_zillow_correlation_matrix %>%
  filter(str_detect(column,"white|black|hispanic")) %>%
  datatable()

There is correlation coefficient of .33 between an areas’ percentage of African-Americans’ and its negative equity rate, a moderate positive relationship. This is not causal, per se, just that a third of the variance in negative equity rates is explained by an areas’ concentration of African Americans. Areas with higher rates of African-Americans tend to have higher negative equity rates.

ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_black_2017", add="loess", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
  stat_cor(method = "pearson", label.x =15, label.y = 15)

There is correlation coefficient of .30 between an areas’ percentage of Hispanics and its negative equity rate, a moderate positive relationship. This is not causal, per se, just that a third of the variance in negative equity rates is explained by an areas’ concentration of African Americans. Areas with higher rates of Hispanics tend to have higher negative equity rates.

ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_hispanic_2017", add="loess", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
  stat_cor(method = "pearson", label.x = 16, label.y = 15)

As one might expect, the opposite is true for whiter areas. There is correlation coefficient of -.4 between an areas’ percentage of whites and its negative equity rate, a moderate negative relationship. This is not causal, per se, just that a two-fifths of the variance in negative equity rates is explained by an areas’ concentration of whites. Areas with higher rates of whites tend to have higher lower negative equity rates.

ggscatter(underwater_zips_2019_no_zillow_trimmed, x="percent_negative_equity",y= "pct_white_2017", add="loess", add.params = list(color = "blue", fill = "lightgray"), conf.int=TRUE) +
  stat_cor(method = "pearson", label.x = 16, label.y = 15)

The analysis identified target ZIP codes where reporting could be focused that are emblematic of the larger trend towards higher rates of negative equity in minority neighborhoods.

For majority black neighborhoods, this includes:
* 11208 in Brooklyn, a majority black neighborhood with 26% negative equity; * 07062 (in Plainfield), 07108 (Newark), 07114 (Newark). These north New Jersey neighborhoods all have greater than 16% negative equity. * A cluster of nine ZIP codes in Chicago with greater than 15% negative equity; * A ton more examples, if you look at the table below, which are all majority black neighborhoods, including many Maryland ZIPs

high_negative_equity_zips %>%
  filter(pct_black_2017 > 50) %>%
  datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: majority black ZIP codes with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

At the county level, several areas with large African-American populations have high negative equity rates, including: * Five Maryland counties/city: Prince George’s, Baltimore (city), Charles, Somerset and Dorchester * Seven counties/cities in Virginia. * More in the table below.

high_negative_equity_county_2019 %>%
  dplyr::select(state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
  arrange(desc(pct_black_2017)) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: Counties with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

For majority Hispanic neighborhoods, this includes:
* A cluster of five ZIP codes in Chicago with greater than 14% negative equity; * Two neighborhoods in Connecticut (06608, 06114) * Two neighborhoods in Fresno, California (93606, 93702) * Many more examples in the table below, including several Maryland ZIPs.

high_negative_equity_zips %>%
  filter(pct_hispanic_2017 > 50) %>%
  datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: majority Hispanic ZIP codes with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

At the county level, this includes places with large Hispanic populations, including: * Miami-Dade in Florida * Several counties in California and New Jersey

high_negative_equity_county_2019 %>%
  dplyr::select(state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
  arrange(desc(pct_hispanic_2017)) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: Counties with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

This is not to say that only majority-minority neighborhods are affected. There are hundreds of examples of overwhelmingly white neighborhoods (greater than 90% white) with high rates, including parts of Connecticut, Arizona, Iowa, New Jersey, Maryland and others. See the table below.

high_negative_equity_zips %>%
  filter(pct_white_2017 > 90) %>%
  datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: majority white (90%+) ZIP codes with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

At the county level, places with tiny minority populations that have high negative equity rates include: * Seven Iowa counties and five Illinois counties. * Others on the table below.

high_negative_equity_county_2019 %>%
  dplyr::select(state_name, county_name, pct_negative_equity_y2019, pct_white_2017, pct_black_2017, pct_hispanic_2017) %>%
  arrange(desc(pct_white_2017)) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: Counties with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

Property market charecteristics

Counties with higher levels of negative equity have higher median home values, as measured by the Zillow Home Value Index (zhvi). But property values in these areas are also growing more slowly, as measured by changes in the zillow home value index from the previous month, quarter and year. They are also forecast to grow slower in the next year. This is not to say that negative equity rates caused these trends, just that there are observable differences between the two.

underwater_county_year_yes_zillow %>%
   mutate(negative_equity = case_when(pct_negative_equity_y2019 >= 4 ~ "neg_equity >= 4%",
                                     TRUE ~ "neg_equity < 4%"
                                     )) %>%
  group_by(negative_equity) %>%
  summarise(zhvi = round(mean(zhvi),2),
            zhvi_month_pct_change = round(mean(zhvi_month_pct_change),2),
            zhvi_quarter_pct_change = round(mean(zhvi_quarter_pct_change),2),
            zhvi_year_pct_change = round(mean(zhvi_year_pct_change),2),
            zhvi_five_year_pct_change = round(mean(zhvi_five_year_pct_change),2),
            zhvi_ten_year_pct_change = round(mean(zhvi_ten_year_pct_change),2),
            zhvi_forecast_year_pct_change = round(mean(zhvi_forecast_year_pct_change),2),
            ) %>%
datatable(class = 'cell-border stripe', filter = 'top', rownames = FALSE, caption = htmltools::tags$caption(
    style = 'caption-side: top; text-align: left;',
    '2019: Counties with negative equity >= 4%'
  ),
  options = list(scrollX=TRUE, scrollCollapse=TRUE)
)

underwater_county_year_yes_zillow %>%
  dplyr::select(-matches("code|state|name|county|date|region|Metro|County|City|Month|Quarter|Last|Time|Description")) %>%
  correlate(method = c("pearson")) %>%
  dplyr::select(-RUCC_2013, -pct_negative_equity_y2009:-pct_negative_equity_y2018, -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  filter(!str_detect(rowname,"RUCC|_2017|_2018|2019|zhvi")) %>%
  mutate(corr_with_pct_negative_equity_y2019 = round(pct_negative_equity_y2019, 2)) %>%
  arrange(desc(rowname)) %>%
  datatable(
    extensions = 'FixedColumns',
    options = list(
    pageLength = 50,
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)
  )
  )

## 
## Correlation method: 'pearson'
## Missing treated using: 'pairwise.complete.obs'

underwater_county_year_yes_zillow %>%
  filter(pct_negative_equity_y2019 >= 1) %>%
  ungroup() %>%
  #na.omit() %>%
  mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>% 
  rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
  dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank,  -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  mutate(mean_2009_2019_negative_equity_rank = (pct_negative_equity_y2009_rank+pct_negative_equity_y2019_rank)/2) %>%
  dplyr::select(state_name, county_name, mean_2009_2019_negative_equity_rank, everything()) %>%
  arrange(desc(mean_2009_2019_negative_equity_rank)) %>%
  datatable(
    rownames = FALSE,
    extensions = 'FixedColumns',
    options = list(
    pageLength = 50,
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)
  )
  )

underwater_county_year_yes_zillow %>%
  filter(pct_negative_equity_y2019 >= 1) %>%
  ungroup() %>%
  #na.omit() %>%
  mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>% 
  rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
  dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank,  -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  mutate(negative_equity_rank_change_2009_2019 = (pct_negative_equity_y2009_rank-pct_negative_equity_y2019_rank)) %>%
  dplyr::select(state_name, county_name, negative_equity_rank_change_2009_2019, everything()) %>%
  arrange(desc(negative_equity_rank_change_2009_2019)) %>%
  filter(!is.na(negative_equity_rank_change_2009_2019)) %>%
  datatable(
    rownames = FALSE,
    extensions = 'FixedColumns',
    options = list(
    pageLength = 50,
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)
  )
  )

underwater_county_year_yes_zillow %>%
  filter(pct_negative_equity_y2019 >= 1) %>%
  ungroup() %>%
  #na.omit() %>%
  mutate_at(vars(contains("y20")), funs(round(percent_rank(.)*100,0))) %>% 
  rename_at(vars(contains("y20")), function(x) paste0(x,"_rank")) %>%
  dplyr::select(-fips_code, -RUCC_2013, -pct_negative_equity_y2010_rank:-pct_negative_equity_y2018_rank,  -pct_white_2017:-zhvi_forecast_year_pct_change) %>%
  mutate(negative_equity_rank_change_2009_2019 = (pct_negative_equity_y2009_rank-pct_negative_equity_y2019_rank)) %>%
  dplyr::select(state_name, county_name, negative_equity_rank_change_2009_2019, everything()) %>%
  arrange(negative_equity_rank_change_2009_2019) %>%
  filter(!is.na(negative_equity_rank_change_2009_2019)) %>%
  datatable(
    rownames = FALSE,
    extensions = 'FixedColumns',
    options = list(
    pageLength = 50,
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)
  )
  )

Loan to Value Buckets

We have data from 2017 (nothing later) via Zillow that has loan to value buckets for each county and ZIP code. I’m still working on analyzing this.

negative_equity_summary_county %>%
  datatable(rownames = FALSE,
    extensions = 'FixedColumns',
    options = list(
    pageLength = 50,
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)))

## Warning in instance$preRenderHook(instance): It seems your data is too
## big for client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.html

# Filter by zip

negative_equity_summary_zip %>%
  datatable(rownames = FALSE,
    extensions = 'FixedColumns',
    options = list(
    pageLength = 50,
    dom = 't',
    scrollX = TRUE,
    fixedColumns = list(leftColumns = 2)))

## Warning in instance$preRenderHook(instance): It seems your data is too
## big for client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.html

## Load and clean zillow data from data.world
#Strategy
#What are the ramifications of negative equity?

#Negative equity can cast a shadow over the economy, effectively prolonging an economic downturn. Just as skyrocketing home values can drive confidence and spending, negative equity can keep people home, literally. Many people who might have found jobs in other markets were tied to their homes and unable to sell because the money they would make from selling would not be enough to pay off their mortgages. Negative equity can have a number of other chilling impacts on local housing markets, disproportionately impacting minority communities and owners of lower-valued homes, exacerbating inventory shortages and increasing the likelihood of foreclosure for underwater homeowners.
# https://www.zillow.com/research/negative-equity-race-q3-2016-14063/
# https://www.zillow.com/research/q3-2016-negative-equity-report-13954/

#HOLY SHIT THERE S A FUCKING MODEL ON PAGE 14 that has everything I need. #https://www.frbatlanta.org/-/media/documents/community-development/publications/discussion-papers/2016/01-housing-negative-equity-in-sixth-federal-reserve-district-2016-03-10.pdf

#https://www.zillow.com/research/q3-2016-negative-equity-report-13954/
#But this drop, while encouraging, masks the often very wide divide that remains between the top of the market and the bottom of the market. In a number of large markets, the spread between the negative equity rate at the top and the bottom of the market is alarmingly wide. In Detroit, for example, the negative equity rate among top-tier homes is 4.4 percent; among bottom-tier homes, the negative equity rate is almost ten times higher at 39 percent – a gap of 34.6 percentage points, the largest gap among the 35 largest metros analyzed. The gap between top-tier and bottom-tier negative equity is more than 20 percentage points in an additional four large metros: Cleveland (28.1 points), St. Louis (22 points), Atlanta (21 points) and Chicago (20.5 points).